perm filename LIBPAS.NDF[PAS,SYS]1 blob
sn#452541 filedate 1979-07-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00054 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00009 00002 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 1,1
C00013 00003 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 1,1
C00017 00004 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 2,2
C00020 00005 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 2,2
C00023 00006 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 4,2
C00027 00007 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
C00030 00008 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
C00033 00009 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
C00036 00010 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
C00038 00011 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
C00041 00012 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
C00044 00013 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
C00047 00014 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
C00050 00015 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
C00053 00016 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
C00056 00017 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
C00059 00018 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
C00062 00019 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
C00066 00020 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
C00069 00021 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
C00072 00022 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 13,3
C00075 00023 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 19,4
C00078 00024 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 25,5
C00081 00025 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 26,7
C00085 00026 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 26,7
C00089 00027 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 26,7
C00092 00028 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 27,7
C00095 00029 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 27,7
C00098 00030 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 27,7
C00101 00031 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 27,7
C00104 00032 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
C00107 00033 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
C00110 00034 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
C00113 00035 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
C00116 00036 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
C00118 00037 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
C00121 00038 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 29,7
C00124 00039 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 29,7
C00127 00040 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 29,8
C00130 00041 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,8
C00134 00042 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00137 00043 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00141 00044 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00144 00045 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00147 00046 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00150 00047 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00154 00048 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00157 00049 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00160 00050 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00164 00051 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00167 00052 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00170 00053 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00173 00054 1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
C00174 ENDMK
C⊗;
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 1,1
**** File 1) LIBOLD.TRY[PAS,SYS], Page 1 line 3
1) (*$E+,T-,S1200
1) PASCAL RUNTIME PROGRAM LIBRARY (24-AUG-76,KISICKI)
1) DICTIONARY:
1) PAGE1 : DICTIONARY
1) PAGE2 : CCL
1) PAGE3 : DDT
1) PAGE4 : STATUS
1) PAGE5 : READ
1) PAGE6 : WRITE
1) PAGE7 : UNDEFINED
1) *)
1) PROGRAM ccl, option, getoption, getfilename, getparameter;
1) (******************************************************************************************
1) *
**** File 2) LIBPAS.TRY[PAS,SYS], Page 1 line 3
2) (*$E+,S1200,T-
2) PASCAL RUNTIME PROGRAM LIBRARY (ARMANDO RODRIGUEZ, SEPT-78)
2) DERIVED FROM (KISICKI,24-AUG-76)
2) DICTIONARY:
2) PAGE1 : DICTIONARY
2) PAGE2 : CCL HIGHLY MODIFIED VERSION
2) PAGE3 : DDT
2) PAGE4 : STATUS
2) PAGE5 : READ HIGHLY MODIFIED VERSION
2) PAGE6 : WRITE
2) PAGE7 : TIMING FOR PASSGO-GENERATED PROGRAMS.
2) PAGE8 : STRINGS NON-STANDARD 'STRING' PACKAGE.
2) PAGE9 : DUMPER FOR STATMENT COUNTS (/PROFILE SWITCH)
2) PAGE10 : MATHRUN TO GIVE ERRORS ON CALLS TO FTN ROUTINES.
2) NOTE: COMPILING THIS SOURCE WITH THE SWITCH (OR COMPILE OPTION) VERSION:
2) 3: LOCAL FOR PASCAL AND PASSGO AT STANFORD ARTIFICIAL INTELLIGENCE LAB.
2) *)
2) PROGRAM ccl, option, getoption, getfilename, askfilename, startfile, getparameter, getnextcall, reenter;
2) (******************************************************************************************
2) *
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * BOARD OF TRUSTEES
2) * LELAND STANFORD JUNIOR UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * ARMANDO R. RODRIGUEZ
2) * LOTS COMPUTER FACILITY
2) * STANFORD UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 1,1
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 1 line 43
1) * DEFINITIONS:
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 37
2) * MODIFIED 1-APR-1978 BY ARMANDO R. RODRIGUEZ, STANFORD UNIVERSITY
2) * + SWITCHES CAN TAKE NEGATIVE AND ALPHABETIC VALUES.
2) * + GETPARAMETER WAS BROKEN INTO ASKFILENAME AND STARTFILE
2) * TO ALLOW THEIR USE BY USER PROGRAMS.
2) *
2) * MODIFIED 13-JUL-1978 BY ARMANDO R. RODRIGUEZ, STANFORD UNIVERSITY
2) * + TAKE IN A SECOND LINE THE NAME OF A PROGRAM TO BE CALLED NEXT.
2) *
2) * MODIFIED 18-AUG-1978 BY ARMANDO R. RODRIGUEZ, STANFORD UNIVERSITY
2) * + ADD THE PROCEDURE REENTER, TO RESET WHAT IS SET IN THE
2) * INITPROCEDURE, TO ALLOW FOR RESTARTABLE PASCAL PROGRAMS.
2) *
2) * DEFINITIONS:
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 1 line 53
1) * <VALUE> ::= <UNSIGNED DECIMAL NUMBER>
1) *
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 59
2) * <VALUE> ::= <DECIMAL NUMBER> OR <LETTER>
2) *
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 2 line 4
1) pack6 = PACKED ARRAY[1..6] OF char;
1) pack5 = PACKED ARRAY[1..5] OF char;
1) source_form = (tempfile,commandfile,teletypeoutput,teletypeinput,teletype);
1) delimiter = (blank,lparent,rparent,comma,point,slash,less,equal,greater,rbrack,lbrack,colon,exclamation,unknown);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 66
2) pack7 = PACKED ARRAY[1..7] OF char;
2) pack6 = PACKED ARRAY[1..6] OF char;
2) pack5 = PACKED ARRAY[1..5] OF char;
2) pack3 = PACKED ARRAY[1..3] OF char;
2) source_form = (tempfile,teletypeoutput,teletypeinput,teletype);
2) delimiter = (blank,lparent,rparent,comma,point,slash,less,equal,greater,rbrack,lbrack,colon,exclamation,unknown);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 2 line 17
1) tmp_filename, com_filename, file_old: pack9;
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 2,2
1) source: source_form;
1) end_of_filename, defaulted, error, usercall: boolean;
1) lastch: char;
1) device_old: pack6;
1) current_switch, new_switch, switch_tree: swp;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 81
2) programname: alfa;
2) tmp_filename, file_old: pack9;
2) source: source_form;
2) fromtmpfile,
2) end_of_filename, defaulted, error, usercall: boolean;
2) breakchar,
2) lastch: char;
2) device_old: pack6;
2) next_name,
2) filename: pack9;
2) next_device,
2) device: pack6;
2) current_switch, new_switch, switch_tree: swp;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 2 line 25
1) delimiter3: ARRAY['['..'_'] OF delimiter;
1) INITPROCEDURE;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 96
2) delimiter3: ARRAY['['..']'] OF delimiter;
2) INITPROCEDURE;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 2 line 31
1) com_filename := ' CMD';
1) tmp_filename := ' TMP';
1) switch_tree := NIL; current_switch := NIL;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 103
2) tmp_filename := ' TMP';
2) next_name := ' ';
2) next_device := ' ';
2) switch_tree := NIL; current_switch := NIL;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 2 line 41
1) delimiter3['_'] := equal;
1) END;
1) (** ENTER ENTER_SWITCH **)
1) PROCEDURE enter(fname: alfa; fvalue: integer);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 2,2
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 114
2) END;
2) PROCEDURE reenter; (* ADDED TO ALLOW FOR RESTART OF PASCAL PROGRAMS*)
2) BEGIN (* REENTER *)
2) source := tempfile; callcnt := 0; usercall := true; error := false;
2) defaulted := true; lastch := ' ';
2) tmp_filename := ' TMP';
2) next_name := ' ';
2) next_device := ' ';
2) switch_tree := NIL; current_switch := NIL;
2) END (* REENTER *);
2) PROCEDURE enter(fname: alfa; fvalue: integer);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 4 line 1
1) (** OPTION FIND_SWITCH GETOPTION PICTURE **)
1) (**********************************************************************
1) *
1) * FUNCTION OPTION
1) *
1) * - TEST IF <SWITCH> "SWITCHNAME" HAS BEEN
1) * SPECIFIED IN THE DECSYSTEM-10 COMMAND-STRING
1) * INTERPRETED BY PREVIOUS GETPARAMETER-/GETFILENAME-CALLS.
1) *
1) * OPTION IS A PRE-DECLARED FUNCTION AND AVAILABLE TO EVERY
1) * PASCAL USER.
1) *
1) **********************************************************************)
1) FUNCTION option(switchname: alfa): boolean;
1) FUNCTION find_switch( ftree: swp): boolean;
1) BEGIN
1) IF ftree <> NIL THEN
1) WITH ftree↑ DO
1) IF switchname = name THEN
1) BEGIN
1) find_switch := true; current_switch := ftree
1) END
1) ELSE
1) IF switchname < name THEN
1) find_switch := find_switch(left)
1) ELSE
1) find_switch := find_switch(right)
1) ELSE find_switch := false
1) END (* FIND_SWITCH *);
1) BEGIN (*OPTION*)
1) IF switch_tree = NIL THEN
1) option := false
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 4,2
1) ELSE
1) option := find_switch(switch_tree)
1) END (*OPTION*);
1) (**********************************************************************
1) *
1) * PROCEDURE GETOPTION
1) *
1) * - ASSIGN <VALUE> OF "SWITCHNAME" TO "SWITCHVALUE".
1) *
1) * GETOPTION IS A PRE-DECLARED PROCEDURE AND AVAILABLE TO EVERY
1) * PASCAL USER.
1) *
1) **********************************************************************)
1) PROCEDURE getoption(switchname: alfa; VAR switchvalue: integer);
1) BEGIN
1) IF option(switchname) THEN
1) WITH current_switch↑ DO
1) switchvalue := value
1) ELSE
1) switchvalue := 0
1) END (* GETOPTION *);
1) FUNCTION picture(fch: char): delimiter;
1) BEGIN
1) IF fch IN [' ','!','(',')',',','.','/',':','<','=','>','[',']','_'] THEN
1) IF fch <= '/' THEN picture := delimiter1[fch]
1) ELSE
1) IF fch <= '>' THEN picture := delimiter2[fch]
1) ELSE picture := delimiter3[fch]
1) ELSE picture := unknown;
1) END (* PICTURE *);
1) (** GETFILENAME RE_INITIALIZE INITIALIZE READCHAR READOCTAL READDECIMAL SETSTATUS READSWITCH OPERAND NEXTCH ASSIGNFILENAMEOREXTENSION **)
1) (**********************************************************************
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 152
2) (**********************************************************************
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 21
1) i, j, k, imax, ocval, source_prot, source_ppn: integer;
1) source_fil: PACKED ARRAY[1..9] OF char;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 171
2) i, j, k, imax, ocval, sign, source_prot, source_ppn: integer;
2) source_fil: PACKED ARRAY[1..9] OF char;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 29
1) i := 0; buffer := ' '; ocval := 0;
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
1) new_status := false;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 179
2) i := 0; buffer := ' '; ocval := 0; sign :=1;
2) new_status := false;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 40
1) PROCEDURE readchar;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 190
2) FUNCTION picture(fch: char): delimiter;
2) BEGIN
2) IF fch IN [' ','!','(',')',',','.','/',':','<','=','>','[',']'] THEN
2) IF fch <= '/' THEN picture := delimiter1[fch]
2) ELSE
2) IF fch <= '>' THEN picture := delimiter2[fch]
2) ELSE picture := delimiter3[fch]
2) ELSE picture := unknown;
2) END (* PICTURE *);
2) PROCEDURE readchar;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 56
1) PROCEDURE readsixbit;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 216
2) %34
2) PROCEDURE readsixbit;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 60
1) ocval := ocval * 100B + (ord(ch) - ord(' '))
1) END
1) ELSE error := true
1) END (*READSIXBIT*) ;
1) PROCEDURE readdecimal;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 221
2) ocval := ocval * 100B + (ord(ch) - ord(' '));
2) END
2) ELSE
2) error := true;
2) END (*READSIXBIT*);
2) \
2) PROCEDURE readdecimal;
***************
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 71
1) ELSE error := true
1) END (*READDECIMAL*) ;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 234
2) ELSE
2) IF ocval = 0 THEN
2) IF ch IN ['A'..'Z'] THEN
2) ocval:=ord(ch)
2) ELSE
2) IF ch = '-' THEN
2) sign:=-1
2) ELSE
2) error := true
2) ELSE
2) error := true;
2) END (*READDECIMAL*) ;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 125
1) ELSE read(sourcefile,ch);
1) lastch := ch
1) EXIT IF NOT (ch IN ['0'..'9',':','A'..'Z',' ']) OR end_of_switch;
1) IF ch <> ' ' THEN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 298
2) ELSE
2) BEGIN
2) read(sourcefile,ch);
2) %34
2) IF ch = '_' THEN
2) ch := '=';
2) \
2) END;
2) lastch := ch
2) EXIT IF NOT (ch IN ['0'..'9',':','A'..'Z',' ','-']) OR end_of_switch;
2) IF ch <> ' ' THEN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 134
1) IF i > 0 THEN enter(buffer,ocval)
1) UNTIL NOT (ch IN ['/','!',',']) OR ((ch = ',') AND (status <> '(')) OR end_of_switch;
1) IF ch IN [',','=','_'] THEN
1) BEGIN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 314
2) IF i > 0 THEN enter(buffer,ocval*sign)
2) UNTIL NOT (ch IN ['/',',']) OR ((ch = ',') AND (status <> '(')) OR end_of_switch;
2) IF ch IN [',','=']THEN
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
2) BEGIN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 150
1) BEGIN
1) end_of_filename := true; ch := ' '
1) END
1) ELSE read(sourcefile,ch);
1) lastch := ch;
1) IF end_of_filename OR ((ch=',') AND (status<>'[')) OR (ch IN ['=','_']) THEN
1) BEGIN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 330
2) %34
2) IF status = ',' THEN
2) ch := ']'
2) ELSE
2) \
2) BEGIN
2) end_of_filename := true;
2) ch := ' ';
2) END
2) ELSE
2) BEGIN
2) read(sourcefile,ch);
2) %34
2) IF ch = '_' THEN
2) ch := '=';
2) \
2) END;
2) lastch := ch;
2) IF end_of_filename OR ((ch=',') AND (status<>'[')) OR (ch='=') THEN
2) BEGIN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 185
1) IF status IN ['[',','] THEN readsixbit
1) ELSE
1) IF status = '<' THEN readoctal
1) ELSE readchar
1) ELSE setstatus
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 378
2) IF status IN ['[',',','<'] THEN
2) %34
2) IF status <> '<' THEN
2) readsixbit
2) ELSE
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
2) \
2) readoctal
2) ELSE readchar
2) ELSE setstatus
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 194
1) BEGIN
1) IF i > 0 THEN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 391
2) BEGIN (*ASSIGNFILENAMEOREXTENSION*)
2) IF i > 0 THEN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 5 line 202
1) END;
1) BEGIN
1) (*GETFILENAME*)
1) IF usercall THEN
1) BEGIN
1) getstatus(sourcefile, source_fil, source_prot, source_ppn, source_dev);
1) IF source_dev = 'TTY ' THEN
1) BEGIN
1) write(tty,cr,lf,filevariable,'= ');
1) break(tty);
1) readln(sourcefile)
1) END
1) END;
1) initialize;
1) IF NOT eof(sourcefile) THEN
1) IF NOT eoln(sourcefile) THEN
1) REPEAT
1) operand;
1) IF NOT error THEN
1) BEGIN
1) CASE picture(status) OF
1) colon:
1) IF i > 0 THEN BEGIN
1) device := ' ' ;
1) FOR j := 1 TO i DO device[j] := buffer[j];
1) END ;
1) point:
1) BEGIN
1) assignfilenameorextension; imax := 3
1) END;
1) less,
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
1) lbrack:
1) assignfilenameorextension;
1) lparent,
1) slash:
1) BEGIN
1) assignfilenameorextension; readswitch
1) END;
1) comma :
1) IF ocval >= 400000B THEN ufd := (ocval-400000B) * 1000000B + 400000000000B
1) ELSE ufd := ocval * 1000000B;
1) rbrack :
1) ufd := ufd + ocval;
1) greater :
1) protection := ocval
1) END;
1) re_initialize; defaulted := false
1) END
1) UNTIL error OR end_of_filename;
1) defaulted := filename[1] = ' ';
1) IF NOT (usercall OR defaulted) THEN
1) IF NOT error AND eoln(sourcefile) AND (pred(source) <= commandfile) AND NOT eof(sourcefile) THEN
1) BEGIN
1) readln(sourcefile); status := ' '; ch := ' '; readswitch
1) END;
1) IF error AND usercall THEN
1) BEGIN
1) writeln(tty,'%? SYNTAX ERROR: REENTER'); break(tty);
1) getfilename(sourcefile,filename,protection,ufd,device,filevariable)
1) END
1) ELSE usercall := true
1) END (*GETFILENAME*);
1) (** GETPARAMETER INITIALIZE **)
1) (**********************************************************************
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 399
2) END (*ASSIGNFILENAMEOREXTENSION*);
2) (***********************************************************************
2) *
2) * PROCEDURE GETNEXTPROCESSOR
2) *
2) * _ READ THE SECOND LINE OF A TOPS-20 CCL FILE.
2) *
2) * <FILENAME>!
2) *
2) * WHERE FILENAME IS A NAME OF A PROGRAN TO BE RUN AFTER PASCAL
2) *
2) ***********************************************************************)
2) PROCEDURE getnextprocessor;
2) VAR
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
2) token: pack7;
2) brkchar: char;
2) PROCEDURE gettoken(VAR token: pack7;
2) VAR brkch: char);
2) BEGIN
2) i := 1; token := ' ';
2) read(sourcefile,ch);
2) WHILE NOT (ch IN [':','.','!']) AND NOT eoln(sourcefile) AND (i <= 7) DO
2) BEGIN
2) token[i] := ch;
2) read(sourcefile,ch); i := i + 1;
2) END;
2) IF ch IN [':','.','!'] THEN
2) brkch := ch
2) ELSE
2) brkch := ' ';
2) END (* GETTOKEN *);
2) BEGIN (* GETNEXTPROCESSOR *)
2) gettoken(token, brkchar);
2) IF brkchar = ':' THEN
2) BEGIN
2) FOR i:=1 TO 6 DO
2) next_device[i] := token[i];
2) gettoken (token, brkchar);
2) END
2) ELSE
2) next_device := 'DSK ';
2) IF brkchar IN ['.', '!'] THEN
2) BEGIN
2) FOR i:=1 TO 6 DO
2) next_name[i] := token[i];
2) IF brkchar = '.' THEN (* SKIP EXTENSION *)
2) gettoken(token, brkchar);
2) IF brkchar <> '!' (* LINE NOT TERMINATING CORRECTLY *) THEN
2) next_name := ' ';
2) END
2) ELSE
2) next_name := ' ';
2) END (* GETNEXTPROCESSOR *);
2) BEGIN (*GETFILENAME*)
2) LOOP
2) IF usercall THEN
2) BEGIN
2) getstatus(sourcefile, source_fil, source_prot, source_ppn, source_dev);
2) IF source_dev = 'TTY ' THEN
2) BEGIN
2) write(tty,cr,lf,filevariable,'= ');
2) break(tty);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
2) readln(sourcefile)
2) END
2) END;
2) initialize;
2) IF NOT eof(sourcefile) THEN
2) IF NOT eoln(sourcefile) THEN
2) REPEAT
2) operand;
2) IF NOT error THEN
2) BEGIN
2) CASE picture(status) OF
2) colon:
2) IF i > 0 THEN BEGIN
2) device := ' ' ;
2) FOR j := 1 TO i DO device[j] := buffer[j];
2) END ;
2) point:
2) BEGIN
2) assignfilenameorextension; imax := 3
2) END;
2) less,
2) lbrack:
2) assignfilenameorextension;
2) lparent,
2) slash:
2) BEGIN
2) assignfilenameorextension; readswitch
2) END;
2) comma :
2) %34
2) IF ocval >= 400000B THEN
2) ufd := (ocval - 400000B) * 1000000B + 400000000000B
2) ELSE
2) \
2) ufd := ocval * 1000000B;
2) rbrack :
2) ufd := ufd + ocval;
2) greater :
2) protection := ocval
2) END;
2) re_initialize; defaulted := false
2) END
2) UNTIL error OR end_of_filename;
2) defaulted := (filename[1] = ' ') AND (device = 'DSK ');
2) IF NOT defaulted THEN
2) IF NOT error AND eoln(sourcefile) AND (pred(source) = tempfile) AND NOT eof(sourcefile) THEN
2) BEGIN
2) readln(sourcefile);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 5,2
2) status := ' ';
2) ch := ' ';
2) IF NOT eoln (sourcefile) THEN
2) BEGIN
2) lastch := ' ';
2) getnextprocessor;
2) END;
2) END;
2) EXIT IF NOT (error AND usercall);
2) writeln(tty,'%? SYNTAX ERROR: REENTER'); break(tty);
2) END;
2) usercall := true;
2) END (*GETFILENAME*);
2) (**********************************************************************
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 6 line 11
1) * * A COMMAND-FILE NAMED <1ST 6 CHARS. OF PROGRAMNAME>.CMD,
1) * CREATED BY USER, OR
1) *
1) * * TTY
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 540
2) * * TTY
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 6 line 29
1) * THE INPUT FORMAT IS FOR
1) *
1) * * TEMPCORE- AND COMMAND-FILES:
1) *
1) * <FILE SPECIFICATION>,...,<FILE SPECIFICATION><CR><LF>
1) * <SWITCH>!...<SWITCH>!<CR><LF>
1) *
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 555
2) * ASKFILENAME AND STARTFILE CONTAIN WHAT ORIGINALLY WAS GETPARAMETER,
2) * BROKEN IN TWO PARTS SO THAT YOU CAN SUPRESS OPPENING OF
2) * THE FILE (STARTFILE) IF DESIRED SO. THEY ARE BOTH PRE-DECLARED
2) * PROCEDURES, AND AVAILABLE TO EVERY PASCAL USER.
2) * (CHANGE MADE AT LOTS, STANFORD UNIVERSITY, BY ARMANDO
2) * RODRIGUEZ, 1-APR-1978).
2) *
2) * THE INPUT FORMAT IS FOR
2) *
2) * * TEMPCORE-FILES:
2) *
2) * <FILE SPECIFICATION>,...,<FILE SPECIFICATION>/<SWITCH>.../<SWITCH><CR><LF>
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
2) * <DEVICE>:<FILENAME>!<CR><LF>
2) *
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 6 line 44
1) PROCEDURE getparameter(VAR currentfile: anyfile;
1) VAR fileident,programname:alfa;
1) inputfile:boolean);
1) VAR
1) protection, ufd, i: integer;
1) filename: pack9;
1) device: pack6;
1) PROCEDURE initialize;
1) BEGIN
1) IF source <> teletype THEN
1) BEGIN
1) CASE source OF
1) tempfile:
1) BEGIN
1) FOR i := 1 TO 6 DO com_filename[i] := programname[i];
1) FOR i := 1 TO 3 DO tmp_filename[i] := programname[i];
1) reset(tty,tmp_filename,0,0,'DSK ')
1) END;
1) commandfile:
1) reset(tty,com_filename);
1) teletypeoutput:
1) rewrite(tty,'TTYOUTPUT');
1) teletypeinput:
1) reset(tty,'TTY ',0,0,'TTY ')
1) END;
1) source := succ(source);
1) IF eof(tty) AND NOT (source IN [teletypeinput,teletype]) THEN initialize;
1) END
1) END (* INITIALIZE *);
1) BEGIN (*GETPARAMETER*)
1) IF callcnt = 0 THEN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 578
2) PROCEDURE initialize;
2) VAR
2) i: integer;
2) BEGIN
2) IF source <> teletype THEN
2) BEGIN
2) CASE source OF
2) tempfile:
2) BEGIN
2) FOR i := 1 TO 3 DO tmp_filename[i] := programname[i];
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
2) reset(tty,tmp_filename,0,0,'DSK ')
2) END;
2) teletypeoutput:
2) rewrite(tty,'TTYOUTPUT');
2) teletypeinput:
2) reset(tty,'TTY ',0,0,'TTY ')
2) END;
2) source := succ(source);
2) IF eof(tty) AND NOT (source IN [teletypeinput,teletype]) THEN initialize;
2) END
2) END (* INITIALIZE *);
2) PROCEDURE askfilename(VAR filename: pack9;
2) VAR protection,ufd: integer;
2) VAR device: pack6;
2) fileident,progname: alfa;
2) inputfile: boolean;
2) VAR fromtmpfile: boolean;
2) VAR breakchar: char);
2) BEGIN (*ASKFILENAME*)
2) programname:=progname;
2) IF callcnt = 0 THEN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 6 line 79
1) getstatus(currentfile,file_old,prot_old,ufd_old,device_old);
1) LOOP
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 614
2) LOOP
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 6 line 96
1) IF NOT error THEN
1) IF defaulted THEN
1) IF inputfile THEN
1) reset(currentfile,file_old,prot_old,ufd_old,device_old)
1) ELSE
1) rewrite(currentfile,file_old,prot_old,ufd_old,device_old)
1) ELSE
1) IF inputfile THEN
1) reset(currentfile,filename,protection,ufd,device)
1) ELSE
1) rewrite(currentfile,filename,protection,ufd,device)
1) EXIT IF ( (NOT eof(currentfile) AND inputfile) OR (eof(currentfile) AND NOT inputfile) ) AND NOT error;
1) IF source <> teletype THEN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 628
2) EXIT IF NOT error;
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
2) IF source <> teletype THEN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 6 line 112
1) IF error THEN writeln(tty,'%? SYNTAX ERROR: REENTER')
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 633
2) writeln(tty,'%? SYNTAX ERROR: REENTER');
2) break(tty);
2) END;
2) fromtmpfile := pred(source) = tempfile;
2) breakchar := lastch;
2) END (*ASKFILENAME*);
2) PROCEDURE startfile(VAR currentfile: anyfile;
2) VAR filename: pack9;
2) VAR protection,ufd: integer;
2) VAR device: pack6;
2) inputfile: boolean;
2) fileident: alfa;
2) defaultext: pack3);
2) VAR
2) i: integer;
2) extdefaulted: boolean;
2) tempfile: pack9;
2) BEGIN (*STARTFILE*)
2) IF usercall = true THEN
2) BEGIN
2) defaulted:=(filename=' ') AND (device = 'DSK ');
2) source:=teletype;
2) FOR i:=1 TO 9 DO
2) file_old[i]:=fileident[i];
2) prot_old:=0;
2) ufd_old:=0;
2) device_old:='DSK ';
2) extdefaulted := (filename[7] = ' ') AND (defaultext[1] <> ' ');
2) END
2) ELSE
2) extdefaulted := false;
2) error:=false;
2) LOOP
2) IF NOT error THEN
2) IF defaulted THEN
2) IF inputfile THEN
2) BEGIN
2) IF device_old = 'TTY ' THEN
2) BEGIN
2) write(tty,'TO CONTINUE, HIT THE RETURN KEY *');
2) break(tty);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
2) END;
2) reset(currentfile,file_old,prot_old,ufd_old,device_old)
2) END
2) ELSE
2) rewrite(currentfile,file_old,prot_old,ufd_old,device_old)
2) ELSE
2) BEGIN
2) IF extdefaulted THEN
2) BEGIN
2) tempfile := filename;
2) FOR i := 1 TO 3 DO
2) filename[i + 6] := defaultext[i];
2) END;
2) IF inputfile THEN
2) BEGIN
2) IF device = 'TTY ' THEN
2) BEGIN
2) write(tty,'TO CONTINUE, HIT THE RETURN KEY *');
2) break(tty);
2) END;
2) reset(currentfile,filename,protection,ufd,device);
2) IF extdefaulted AND eof(currentfile) THEN
2) reset(currentfile,tempfile,protection,ufd,device);
2) END
2) ELSE
2) rewrite(currentfile,filename,protection,ufd,device);
2) END;
2) EXIT IF ( (NOT eof(currentfile) AND inputfile) OR (eof(currentfile) AND NOT inputfile) ) AND NOT error;
2) IF source <> teletype THEN
2) BEGIN
2) source := teletypeoutput; initialize
2) END;
2) IF error THEN writeln(tty,'%? SYNTAX ERROR: REENTER')
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 6 line 117
1) ELSE write(tty,filename:6,'.',filename[7],filename[8],filename[9]);
1) writeln(tty,' OR NOT FOUND: REENTER')
1) END;
1) break(tty)
1) END
1) END (*GETPARAMETER*) ;
1) BEGIN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 2 line 715
2) ELSE
2) BEGIN
2) write(tty,filename:6,'.',filename[7],filename[8],filename[9]);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
2) IF extdefaulted THEN
2) write(tty,' NOR TO ',tempfile:6,'. ');
2) END;
2) writeln(tty,' OR NOT FOUND: REENTER')
2) END;
2) break(tty);
2) IF source IN [teletype,teletypeinput] THEN
2) BEGIN
2) write(tty,fileident,'= ');break(tty);
2) IF source = teletypeinput THEN initialize
2) ELSE readln(tty)
2) END;
2) usercall := false;
2) getfilename(tty,filename,protection,ufd,device,' ');
2) IF device = 'LPT ' THEN enter('LPT ',0) ;
2) error := (inputfile AND NOT defaulted AND (device = 'LPT ')) OR error;
2) END
2) END (*STARTFILE*);
2) PROCEDURE getparameter(VAR currentfile: anyfile;
2) VAR fileident,programname:alfa;
2) inputfile:boolean);
2) VAR
2) protection, ufd: integer;
2) BEGIN (*GETPARAMETER*)
2) getstatus(currentfile,file_old,prot_old,ufd_old,device_old);
2) askfilename(filename,protection,ufd,device,fileident,programname,inputfile, fromtmpfile,breakchar);
2) usercall:=false;
2) startfile(currentfile,filename,protection,ufd,device,inputfile,fileident,' ');
2) END (*GETPARAMETER*) ;
2) (**********************************************************************
2) *
2) * FUNCTION OPTION
2) *
2) * - TEST IF <SWITCH> "SWITCHNAME" HAS BEEN
2) * SPECIFIED IN THE DECSYSTEM-10 COMMAND-STRING
2) * INTERPRETED BY PREVIOUS GETPARAMETER-/GETFILENAME-CALLS.
2) *
2) * OPTION IS A PRE-DECLARED FUNCTION AND AVAILABLE TO EVERY
2) * PASCAL USER.
2) *
2) **********************************************************************)
2) FUNCTION option(switchname: alfa): boolean;
2) FUNCTION find_switch( ftree: swp): boolean;
2) BEGIN
2) IF ftree <> NIL THEN
2) WITH ftree↑ DO
2) IF switchname = name THEN
2) BEGIN
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
2) find_switch := true; current_switch := ftree
2) END
2) ELSE
2) IF switchname < name THEN
2) find_switch := find_switch(left)
2) ELSE
2) find_switch := find_switch(right)
2) ELSE find_switch := false
2) END (* FIND_SWITCH *);
2) BEGIN (*OPTION*)
2) IF switch_tree = NIL THEN
2) option := false
2) ELSE
2) option := find_switch(switch_tree)
2) END (*OPTION*);
2) (**********************************************************************
2) *
2) * PROCEDURE GETOPTION
2) *
2) * - ASSIGN <VALUE> OF "SWITCHNAME" TO "SWITCHVALUE".
2) *
2) * GETOPTION IS A PRE-DECLARED PROCEDURE AND AVAILABLE TO EVERY
2) * PASCAL USER.
2) *
2) **********************************************************************)
2) PROCEDURE getoption(switchname: alfa; VAR switchvalue: integer);
2) BEGIN
2) IF option(switchname) THEN
2) WITH current_switch↑ DO
2) switchvalue := value
2) ELSE
2) switchvalue := 0
2) ;
2) END (* GETOPTION *);
2) (**********************************************************************
2) *
2) * PROCEDURE GETNEXTCALL
2) *
2) * - ASSIGN <VALUE> OF "NEXT_NAME" TO "FILENAME" AND
2) * <VALUE> OF "NEXT_DEVICE" TO "DEVICE", THAT IS,
2) * TRANSMIT THE DATA OF THE NEXT PROGRAM TO BE CALLED.
2) *
2) * GETNEXTCALL IS A PRE-DECLARED PROCEDURE AND AVAILABLE TO EVERY
2) * PASCAL USER.
2) *
2) **********************************************************************)
2) PROCEDURE getnextcall (VAR filename: pack9;
2) VAR device: pack6);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 6,2
2) BEGIN (*GETNEXTCALL*)
2) filename := next_name;
2) device := next_device;
2) END (*GETNEXTCALL*);
2) BEGIN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 8 line 1
1) (** DEBUG SYSTEM_ERROR ERROR NEWLINE LENGTH **)
1) PROCEDURE debug;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 3 line 248
2) PROCEDURE debug;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 9 line 1
1) (** INSYMBOL NEXTCH **)
1) PROCEDURE insymbol;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 3 line 308
2) PROCEDURE insymbol;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 10 line 1
1) (** ACRPOINT TESTGLOBALBASIS IDTREE FIRSTBASIS SUCCBASIS SEARCHSECTION SEARCHID **)
1) FUNCTION acrpoint(fint:integer;lleft:leftorright): acr;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 3 line 542
2) FUNCTION acrpoint(fint:integer;lleft:leftorright): acr;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 11 line 1
1) (** GETBOUNDS COMPTYPES **)
1) PROCEDURE getbounds(fsp: stp; VAR fmin,fmax: integer);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 3 line 646
2) PROCEDURE getbounds(fsp: stp; VAR fmin,fmax: integer);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 12 line 1
1) (** NEXTBYTE PUTNEXTBYTE **)
1) FUNCTION nextbyte(fbitsize: integer ): integer;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 3 line 722
2) FUNCTION nextbyte(fbitsize: integer ): integer;
***************
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 13,3
**** File 1) LIBOLD.TRY[PAS,SYS], Page 13 line 1
1) (** LOAD GETFIELD SELECTOR **)
1) PROCEDURE load;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 3 line 775
2) PROCEDURE load;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 14 line 1
1) (** VARIABLE **)
1) PROCEDURE variable;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 3 line 962
2) PROCEDURE variable;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 15 line 1
1) (** EXPRESSION SIMPLEEXPRESSION TERM FACTOR **)
1) PROCEDURE expression;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 4 line 11
2) PROCEDURE expression;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 16 line 1
1) (** SHIFTED_OUT WRITESCALAR PUTSIXBIT **)
1) PROCEDURE shifted_out(name:alfa);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 4 line 132
2) PROCEDURE shifted_out(name:alfa);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 17 line 1
1) (** WRITESTRUCTURE WRITEFIELDLIST **)
1) PROCEDURE writestructure( fsp: stp );
**** File 2) LIBPAS.TRY[PAS,SYS], Page 4 line 249
2) PROCEDURE writestructure( fsp: stp );
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 18 line 1
1) (** ASSIGNMENT **)
1) PROCEDURE assignment;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 4 line 596
2) PROCEDURE assignment;
***************
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 19,4
**** File 1) LIBOLD.TRY[PAS,SYS], Page 19 line 1
1) (** STOPSEARCH PAGEVALUE LINEVALUE BREAKPOINT GETLINPAG **)
1) FUNCTION stopsearch(fline:addrrange):integer;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 4 line 639
2) FUNCTION stopsearch(fline:addrrange):integer;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 20 line 1
1) (** LINEINTERVAL STOPMESSAGE TRACEOUT ONE_VAR_OUT **)
1) PROCEDURE lineinterval(faddr: addrrange; VAR lin1,lin2,pag: integer);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 4 line 818
2) PROCEDURE lineinterval(faddr: addrrange; VAR lin1,lin2,pag: integer);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 21 line 1
1) (** SECTION_OUT OUT **)
1) PROCEDURE section_out(lcp:ctp;fformset:formset);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 4 line 920
2) PROCEDURE section_out(lcp:ctp;fformset:formset);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 22 line 1
1) (** STACK_OUT HEAP_OUT **)
1) PROCEDURE stack_out;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 5 line 12
2) PROCEDURE stack_out;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 23 line 1
1) (** WRITE_PROGRAM_NAME HEADER BACK_TO_TTY CORRECT_ADDR RIGHT_ADDR **)
1) PROCEDURE write_program_name;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 5 line 102
2) PROCEDURE write_program_name;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 24 line 1
1) (** INIT DEBUG_INTERACTIVE **)
1) PROCEDURE init;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 5 line 190
2) PROCEDURE init;
***************
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 25,5
**** File 1) LIBOLD.TRY[PAS,SYS], Page 25 line 1
1) (** DEBUG_BATCH **)
1) PROCEDURE debug_batch;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 5 line 355
2) PROCEDURE debug_batch;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 26 line 1
1) (** GETSTATUS **)
1) PROCEDURE getstatus(file_block: fileblockpointer;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 6 line 42
2) PROCEDURE getstatus(file_block: fileblockpointer;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 26 line 26
1) readcrange, readrrange, readiset, readcset, readdset;
1) (************************************************************************************
1) *
1) * PASCAL RUNTIME SYSTEM (29-JUL-76,KISICKI)
1) *
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 2
2) readcrange, readrrange, readiset, readcset, readdset, readstr;
2) (************************************************************************************
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * BOARD OF TRUSTEES
2) * LELAND STANFORD JUNIOR UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * ARMANDO R. RODRIGUEZ
2) * LOTS COMPUTER FACILITY
2) * STANFORD UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT H.-H. NAGEL
2) * INSTITUT FUER INFORMATIK
2) * DER UNIVERSITAET HAMBURG
2) * SCHLUETERSTRASSE 70
2) * 2000 HAMBURG 13
2) * GERMANY
2) * 1976
2) *
2) * PASCAL RUNTIME SYSTEM
2) * (FROM KISICKI, 29-JUL-76)
2) *
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 26,7
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 26 line 46
1) ************************************************************************************)
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 42
2) * - READSTR : READ A 'STRING' AS DEFINED IN THE NON-STANDARD
2) * STRING PACKAGE. NOT NEEDED IF THE PACKAGE IS
2) * DEACTIVATED.
2) *
2) * NOTICE THAT, TO AVOID EATING MORE CHARACTERS THAN NEEDED,
2) * THE PROCEDURES ARE USING NEXTCH, THAT WORKS LIKE READ,
2) * BUT BACKWARDS, THAT IS, IT FIRST GETS AND THEN ASSIGNS.
2) *
2) ************************************************************************************)
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 26 line 52
1) TYPE
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 55
2) maxstrlen = 135;
2) TYPE
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 26 line 57
1) scalar_form = (integer_form,char_form,real_form,bool_form,declared_form);
1) VAR
1) errormessage: PACKED ARRAY[1..4,1..45] OF char;
1) ch: char; direct_call, error_exit: boolean;
1) identifier: alfa;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 62
2) scalar_form = (integer_form,char_form,real_form,bool_form,declared_form,sstring_form);
2) error_form = (nonalpha,undefined,outofrange,doublydef,nonnumeric,openquote,
2) doublequote,closequote,twoperiods,openbracket,
2) closebracket,endoffile,endofline,toolongstr);
2) string = RECORD
2) strtext: PACKED ARRAY[1..maxstrlen] OF char;
2) len: 0..maxstrlen;
2) END;
2) VAR
2) type_name: PACKED ARRAY[scalar_form,1..7] OF char;
2) errormessage: PACKED ARRAY[error_form,1..25] OF char;
2) ch: char;
2) set_flag, direct_call, error_exit: boolean;
2) identifier: alfa;
***************
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 26,7
**** File 1) LIBOLD.TRY[PAS,SYS], Page 26 line 66
1) errormessage[1] := 'INPUT ERROR: INVALID SCALAR SPECIFICATION ';
1) errormessage[2] := 'INPUT ERROR: SCALAR UNDEFINED OR OUT OF RANGE';
1) errormessage[3] := 'INPUT ERROR; INVALID SET SPECIFICATION ';
1) errormessage[4] := 'INPUT ERROR: SET ELEMENT SPECIFIED DOUBLE ';
1) direct_call := true; error_exit := false;
1) END;
1) (** STOP ERROR NEXTCH SKIP READIRANGE READCRANGE READRRANGE **)
1) PROCEDURE stop; EXTERN;
1) PROCEDURE error( errornumber: integer);
1) BEGIN
1) IF NOT error_exit THEN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 80
2) type_name[integer_form] := 'INTEGER';
2) type_name[char_form] := 'CHAR ';
2) type_name[real_form] := 'REAL ';
2) type_name[bool_form] := 'BOOLEAN';
2) type_name[declared_form] := 'SCALAR ';
2) type_name[sstring_form] := 'STRING ';
2) errormessage[nonalpha ] := 'STARTS WITH NONALPHABETIC';
2) errormessage[undefined ] := 'UNDEFINED OR OUT OF RANGE';
2) errormessage[outofrange ] := 'VALUE OUT OF THE RANGE ';
2) errormessage[doublydef ] := 'SET ELEMENT APPEARS TWICE';
2) errormessage[nonnumeric ] := 'IT STARTS WITH NONNUMERIC';
2) errormessage[openquote ] := 'OPENING QUOTE EXPECTED ';
2) errormessage[doublequote ] := 'QUOTE SHOULD BE DOUBLE ';
2) errormessage[closequote ] := 'CLOSING QUOTE EXPECTED ';
2) errormessage[twoperiods ] := 'TWO PERIODS EXPECTED ';
2) errormessage[openbracket ] := 'OPENING BRACKET EXPECTED ';
2) errormessage[closebracket] := ''','',''..'' OR '']'' EXPECTED ';
2) errormessage[endoffile ] := 'READ ATTEMPTED BEYOND EOF';
2) errormessage[endofline ] := 'EOLINE WHEN CHAR EXPECTED';
2) errormessage[toolongstr ] := 'LINE EXCEEDS MAX LENGTH, ';
2) direct_call := true; error_exit := false; set_flag := false;
2) END;
2) PROCEDURE stop; EXTERN;
2) PROCEDURE wrtfnm(VAR source_file: text); EXTERN;
2) PROCEDURE writefilename(VAR source_file: text);
2) BEGIN (*WRITEFILENAME*)
2) error_exit := false;
2) write(tty,' IN FILE ');
2) break(tty);
2) wrtfnm(source_file);
2) END (*WRITEFILENAME*);
2) PROCEDURE error( errornumber: error_form; type_form: scalar_form);
2) BEGIN (*ERROR*)
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 26,7
2) IF NOT error_exit THEN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 27 line 9
1) write(tty,'%? ',errormessage[errornumber]);
1) break(tty);
1) error_exit := true
1) END
1) END;
1) PROCEDURE nextch( VAR source_file: text);
1) BEGIN
1) IF NOT eoln(source_file) THEN read(source_file,ch)
1) ELSE ch := ' '
1) END;
1) PROCEDURE skip( VAR source_file: text);
1) BEGIN
1) IF eoln(source_file) THEN readln(source_file);
1) nextch(source_file);
1) WHILE (ch = ' ') AND NOT (eof(source_file) OR eoln(source_file)) DO
1) nextch(source_file)
1) END;
1) PROCEDURE readirange( VAR source_file: text;
1) VAR scalar_variable: integer;
1) min_value, max_value: integer);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 120
2) write(tty,'%? INPUT ERROR: READING A ');
2) IF set_flag THEN
2) write(tty,'SET OF ');
2) IF type_form <> sstring_form THEN
2) write(tty,'SUBRANGE OF ');
2) writeln(tty,type_name[type_form],' :');
2) write(tty,' ':8);
2) error_exit := true
2) END;
2) write(tty,errormessage[errornumber]);
2) break(tty);
2) END (*ERROR*);
2) PROCEDURE nextch( VAR source_file: text);
2) BEGIN (*NEXTCH*)
2) get(source_file);
2) ch := source_file↑;
2) END (*NEXTCH*);
2) PROCEDURE skip( VAR source_file: text);
2) BEGIN (*SKIP*)
2) ch := source_file↑;
2) LOOP
2) WHILE (ch = ' ') AND NOT eoln(source_file) DO
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 27,7
2) nextch(source_file);
2) EXIT IF (ch <> ' ') OR eof(source_file);
2) readln(source_file);
2) ch := source_file↑;
2) END
2) END (*SKIP*);
2) PROCEDURE readirange( VAR source_file: text;
2) VAR source_value: integer;
2) min_value, max_value: integer);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 27 line 34
1) BEGIN
1) IF direct_call THEN skip(source_file);
1) negative := false; scalar_variable := 0;
1) IF ch IN ['+','-'] THEN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 157
2) BEGIN (*READIRANGE*)
2) IF direct_call THEN skip(source_file);
2) negative := false; source_value := 0;
2) IF ch IN ['+','-'] THEN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 27 line 45
1) IF NOT (ch IN ['0'..'9']) THEN error(1);
1) WHILE ch IN ['0'..'9'] DO
1) BEGIN
1) scalar_variable := scalar_variable * 10 + (ord(ch) - ord('0'));
1) nextch(source_file)
1) END;
1) IF (scalar_variable < min_value) OR (scalar_variable > max_value) THEN
1) BEGIN
1) error(2); write(tty,' ***',scalar_variable,'***')
1) END;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 168
2) IF NOT (ch IN ['0'..'9']) THEN
2) BEGIN
2) error(nonnumeric,integer_form);
2) writeln(tty,' ***',ch,'***');
2) write(tty,' ':7);
2) END;
2) WHILE ch IN ['0'..'9'] DO
2) BEGIN
2) source_value := source_value * 10 + (ord(ch) - ord('0'));
2) nextch(source_file)
2) END;
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 27,7
2) IF NOT error_exit THEN
2) BEGIN
2) IF negative THEN
2) source_value := - source_value;
2) IF (source_value < min_value) OR (source_value > max_value) THEN
2) BEGIN
2) error(outofrange,integer_form);
2) writeln(tty,' ',min_value,'..',max_value,' ***',source_value,'***');
2) write(tty,' ':7);
2) END;
2) END;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 27 line 59
1) error_exit := false;
1) break(tty);
1) stop
1) END
1) ELSE direct_call := true
1) END;
1) PROCEDURE readcrange( VAR source_file: text;
1) VAR scalar_variable: char;
1) min_value, max_value: char);
1) BEGIN
1) IF eoln(source_file) THEN readln(source_file);
1) read(source_file,ch);
1) scalar_variable := ch;
1) IF (scalar_variable < min_value) OR (scalar_variable > max_value) THEN
1) BEGIN
1) error(2); write(tty,' ***''',scalar_variable,'''***')
1) END;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 194
2) writefilename(source_file);
2) stop
2) END
2) ELSE
2) direct_call := true
2) END (*READIRANGE*);
2) PROCEDURE readcrange( VAR source_file: text;
2) VAR source_value: char;
2) min_value, max_value: char);
2) BEGIN (*READCRANGE*);
2) IF eoln(source_file) THEN
2) BEGIN
2) IF NOT direct_call THEN
2) BEGIN
2) error(endofline,char_form);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 27,7
2) writeln(tty);
2) write(tty,' ':7);
2) END
2) ELSE
2) BEGIN
2) readln(source_file);
2) ch := source_file↑;
2) END;
2) END;
2) IF NOT error_exit THEN
2) BEGIN
2) source_value := source_file↑;
2) get(source_file);
2) IF (source_value < min_value) OR (source_value > max_value) THEN
2) BEGIN
2) error(outofrange,char_form);
2) writeln(tty,' ''',min_value,'''..''',max_value,''' ***''',source_value,'''***');
2) write(tty,' ':7);
2) END;
2) END;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 27 line 79
1) error_exit := false;
1) break(tty);
1) stop
1) END
1) ELSE direct_call := true
1) END;
1) PROCEDURE readrrange( VAR source_file: text;
1) VAR scalar_variable: real;
1) min_value, max_value: real);
1) BEGIN
1) IF eoln(source_file) THEN readln(source_file);
1) read(source_file,scalar_variable);
1) IF (scalar_variable < min_value) OR (scalar_variable > max_value) THEN
1) BEGIN
1) error(2); write(tty,' ***',scalar_variable,'***')
1) END;
1) IF direct_call AND error_exit THEN
1) BEGIN
1) error_exit := false;
1) break(tty);
1) stop
1) END
1) ELSE direct_call := true
1) END;
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 27,7
1) (** READSCALAR READIDENTIFIER READSET **)
1) PROCEDURE readscalar( VAR source_file: text;
1) VAR scalar_variable: integer;
1) min_value, max_value: integer;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 232
2) writefilename(source_file);
2) stop
2) END
2) ELSE
2) direct_call := true
2) END (*READCRANGE*);
2) PROCEDURE readrrange( VAR source_file: text;
2) VAR source_value: real;
2) min_value, max_value: real);
2) BEGIN (*READRRANGE*)
2) skip(source_file);
2) read(source_file,source_value);
2) IF (source_value < min_value) OR (source_value > max_value) THEN
2) BEGIN
2) error(outofrange,real_form);
2) writeln(tty,' ',min_value,'..',max_value);
2) write(tty,' ':8,'***',source_value,'***');
2) IF direct_call THEN
2) BEGIN
2) writefilename(source_file);
2) stop
2) END
2) END;
2) direct_call := true
2) END (*READRRANGE*);
2) PROCEDURE readscalar( VAR source_file: text;
2) VAR source_value: integer;
2) min_value, max_value: integer;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 11
1) BEGIN
1) identifier := ' '; i := 1;
1) IF NOT (ch IN ['A'..'Z']) THEN error(1)
1) ELSE
1) LOOP
1) identifier[i] := ch;
1) nextch(source_file)
1) EXIT IF NOT (ch IN ['0'..'9','A'..'Z','_']);
1) IF i < alfalength THEN i := i + 1
1) END
1) END;
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
1) BEGIN (*READSCALAR*)
1) IF direct_call THEN skip(source_file);
1) readidentifier; scalar_variable := min_value;
1) WHILE (scalar_name↑[-scalar_variable] <> identifier) AND NOT error_exit DO
1) IF scalar_variable < max_value THEN scalar_variable := scalar_variable+1
1) ELSE
1) BEGIN
1) error(2); write(tty,' ***',identifier,'***')
1) END;
1) IF direct_call AND error_exit THEN
1) BEGIN
1) error_exit := false;
1) break(tty);
1) stop
1) END
1) ELSE direct_call := true
1) END;
1) PROCEDURE readset( VAR source_file: text;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 268
2) BEGIN (*READIDENTIFIER*)
2) identifier := ' '; i := 0;
2) IF NOT (ch IN ['A'..'Z']) THEN
2) BEGIN
2) error(nonalpha,declared_form);
2) writeln(tty,'. SUBRANGE IS ',scalar_name↑[min_value],'..',scalar_name↑[max_value]);
2) write(tty,'***':11,ch,'***');
2) END
2) ELSE
2) REPEAT
2) IF i < alfalength THEN
2) BEGIN
2) i := i + 1;
2) identifier[i] := ch;
2) END;
2) nextch(source_file)
2) UNTIL NOT (ch IN ['0'..'9','A'..'Z','_']);
2) END (*READIDENTIFIER*);
2) BEGIN (*READSCALAR*)
2) IF direct_call THEN skip(source_file);
2) readidentifier;
2) IF NOT error_exit THEN
2) BEGIN
2) source_value := min_value;
2) WHILE (scalar_name↑[-source_value] <> identifier) AND NOT error_exit DO
2) IF source_value < max_value THEN source_value := source_value+1
2) ELSE
2) BEGIN
2) error(undefined,declared_form);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
2) writeln(tty,' ',scalar_name↑[-min_value],'..',
2) scalar_name↑[-max_value],' ***',identifier,'***');
2) write(tty,' ':7);
2) END;
2) END;
2) IF direct_call AND error_exit THEN
2) BEGIN
2) writefilename(source_file);
2) stop
2) END
2) ELSE
2) direct_call := true
2) END (*READSCALAR*);
2) PROCEDURE readset( VAR source_file: text;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 59
1) BEGIN
1) subrange := false;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 330
2) BEGIN (*READSET*)
2) set_flag := true;
2) subrange := false;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 69
1) skip(source_file);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 341
2) nextch(source_file);
2) skip(source_file);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 78
1) IF ch <> '''' THEN error(3)
1) ELSE
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 351
2) IF ch <> '''' THEN
2) BEGIN
2) error(openquote,char_form);
2) writeln(tty,'***',ch,'***');
2) write(tty,' ':7);
2) END
2) ELSE
***************
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 82
1) IF scalar_value.ival = ord('''') THEN
1) BEGIN
1) nextch(source_file) ;
1) IF ch <> '''' THEN error(3) ;
1) END ;
1) scalar_value.ival := scalar_value.ival-offset;
1) nextch(source_file);
1) IF ch <> '''' THEN error(3)
1) ELSE nextch(source_file)
1) END
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 360
2) IF scalar_value.cval = '''' THEN
2) BEGIN
2) nextch(source_file) ;
2) IF ch <> '''' THEN
2) BEGIN
2) error(doublequote,char_form);
2) writeln(tty,'***''''',ch,'''***');
2) write(tty,' ':7);
2) END;
2) END ;
2) nextch(source_file);
2) IF NOT error_exit THEN
2) IF ch <> '''' THEN
2) BEGIN
2) error(closequote,char_form);
2) write(tty,'***''',scalar_value.cval);
2) IF scalar_value.cval = '''' THEN
2) write(tty,'''');
2) writeln(tty,ch,'***');
2) write(tty,' ':7);
2) END
2) ELSE nextch(source_file);
2) scalar_value.ival := scalar_value.ival-offset;
2) END
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 95
1) END;
1) IF scalar_value.ival IN set_variable THEN
1) BEGIN
1) IF NOT error_exit THEN
1) BEGIN
1) error(4); write(tty,' ***');
1) CASE element_form OF
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 387
2) END (*CASE ELEMENT_FORM*);
2) IF NOT error_exit THEN
2) BEGIN
2) IF scalar_value.ival IN set_variable THEN
2) BEGIN
2) error(doublydef,element_form); write(tty,' ***');
2) CASE element_form OF
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 112
1) write(tty,'***')
1) END
1) END
1) ELSE
1) IF subrange THEN
1) FOR i := first_scalar+1 TO scalar_value.ival DO
1) set_variable := set_variable + [ i ]
1) ELSE
1) set_variable := set_variable + [ scalar_value.ival ];
1) subrange := false;
1) IF (ch = ' ') AND NOT error_exit THEN skip(source_file)
1) EXIT IF NOT (ch IN [',','.',':']) OR error_exit;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 404
2) writeln(tty,'***');
2) write(tty,' ':7);
2) END
2) ELSE (*NOT(SCALAR_VALUE.IVAL IN SET_VARIABLE)*)
2) IF subrange THEN
2) FOR i := first_scalar+1 TO scalar_value.ival DO
2) set_variable := set_variable + [ i ]
2) ELSE
2) set_variable := set_variable + [ scalar_value.ival ];
2) IF (ch = ' ') THEN skip(source_file)
2) END;
2) subrange := false;
2) EXIT IF NOT (ch IN [',','.',':']) OR error_exit;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 126
1) subrange := true;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 419
2) IF ch = '.' THEN
2) BEGIN
2) nextch(source_file);
2) IF ch <> '.' THEN
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
2) BEGIN
2) error(twoperiods,element_form);
2) writeln(tty,'***.',ch,'***');
2) write(tty,' ');
2) GOTO 111
2) END
2) END;
2) subrange := true;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 28 line 129
1) IF ch = '.' THEN
1) BEGIN
1) nextch(source_file);
1) IF ch <> '.' THEN
1) BEGIN
1) error(3); GOTO 111
1) END
1) END;
1) skip(source_file)
1) END;
1) 111:
1) direct_call := true;
1) IF (ch <> ']') THEN error(3)
1) END
1) ELSE error(3)
1) END
1) ELSE error(3)
1) END;
1) (** READISET READCSET READDSET **)
1) PROCEDURE readiset( VAR source_file: text;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 433
2) nextch(source_file);
2) skip(source_file);
2) END (*LOOP*);
2) 111:
2) direct_call := true;
2) IF NOT error_exit THEN
2) IF (ch <> ']') THEN
2) BEGIN
2) error(closebracket,element_form);
2) writeln(tty,'***',ch,'***');
2) write(tty,' ':7);
2) END
2) ELSE
2) nextch(source_file);
2) END
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 28,7
2) ELSE (*CH <> '['*)
2) BEGIN
2) error(openbracket,element_form);
2) writeln(tty,'***',ch,'***');
2) write(tty,' ':7);
2) END;
2) IF error_exit AND eof(source_file) THEN
2) error(endoffile,element_form);
2) END
2) ELSE (* EOF(SOURCE_FILE) *)
2) error(endoffile,element_form);
2) set_flag := false;
2) END (*READSET*);
2) PROCEDURE readiset( VAR source_file: text;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 29 line 5
1) BEGIN
1) readset(source_file,set_variable,min_value,max_value,NIL,integer_form);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 465
2) BEGIN (*READISET*)
2) readset(source_file,set_variable,min_value,max_value,NIL,integer_form);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 29 line 9
1) error_exit := false;
1) break(tty);
1) stop
1) END
1) END;
1) PROCEDURE readcset( VAR source_file: text;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 469
2) writefilename(source_file);
2) stop
2) END
2) END (*READISET*);
2) PROCEDURE readcset( VAR source_file: text;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 29 line 18
1) BEGIN
1) readset(source_file,set_variable,min_value,max_value,NIL,char_form);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 477
2) BEGIN (*READCSET*)
2) readset(source_file,set_variable,min_value,max_value,NIL,char_form);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 29,7
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 29 line 22
1) error_exit := false;
1) break(tty);
1) stop
1) END
1) END;
1) PROCEDURE readdset( VAR source_file: text;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 481
2) writefilename(source_file);
2) stop
2) END
2) END (*READCSET*);
2) PROCEDURE readdset( VAR source_file: text;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 29 line 32
1) BEGIN
1) readset(source_file,set_variable,min_value,max_value,scalar_name,declared_form);
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 490
2) BEGIN (*READDSET*)
2) readset(source_file,set_variable,min_value,max_value,scalar_name,declared_form);
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 29 line 36
1) error_exit := false;
1) break(tty);
1) stop
1) END
1) END;
1) BEGIN
**** File 2) LIBPAS.TRY[PAS,SYS], Page 7 line 494
2) writefilename(source_file);
2) stop
2) END
2) END (*READDSET*);
2) (**********************************************************************
2) *
2) * PROCEDURE READSTR
2) *
2) * - READS A STRING S FROM THE FILE STRINP.
2) * THE STRING STARTS IN THE CURRENT CHARACTER, AND ENDS
2) * WHEN A CRLF IS FOUND. IF THERE ARE MORE THAN 135
2) * CHARACTERS BEFORE THE CRLF, THEY ARE FLUSHED.
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 29,7
2) * AN ERROR MESSAGE IS ISUED, BUT EXECUTION CONTINUES.
2) *
2) * READSTR IS PART OF THE PASREL RUNTIME-SUPPORT.
2) * A CALL TO READSTR IS GENERATED EACH TIME A VARIABLE OF
2) * THE NON-STANDARD TYPE STRING IS FOUND AS A PARAMETER TO
2) * PROCEDURES READ OR READLN.
2) *
2) *********************************************************************)
2) PROCEDURE readstr(VAR source_file: text; VAR string_variable: string);
2) VAR
2) ch: char;
2) BEGIN (*READSTR*)
2) IF eoln(source_file) THEN
2) BEGIN
2) readln(source_file);
2) ch := source_file↑;
2) END;
2) WITH string_variable DO
2) BEGIN
2) len:=0;
2) WHILE (NOT eoln(source_file)) AND (len < maxstrlen) DO
2) BEGIN
2) len:=len+1;
2) strtext[len]:=source_file↑;
2) get (source_file);
2) END;
2) END;
2) IF NOT eoln(source_file) THEN (* DISCARD EXCEEDING CHARS *)
2) BEGIN
2) error(toolongstr,sstring_form);
2) writeln(tty,maxstrlen:4,' CHARACTERS. REST OF LINE FLUSHED. EXECUTION CONTINUED');
2) write(tty,'***':11);
2) WHILE NOT eoln (source_file) DO
2) BEGIN
2) write(tty,source_file↑);
2) get(source_file);
2) END;
2) write(tty,'***');
2) break(tty);
2) writefilename(source_file);
2) END;
2) END (* READSTR *);
2) BEGIN
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 29 line 49
1) * PASCAL RUNTIME SYSTEM (29-JUL-76,KISICKI)
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 29,8
**** File 2) LIBPAS.TRY[PAS,SYS], Page 8 line 5
2) * (C) COPYRIGHT 1978, 1979
2) * BOARD OF TRUSTEES
2) * LELAND STANFORD JUNIOR UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * ARMANDO R. RODRIGUEZ
2) * LOTS COMPUTER FACILITY
2) * STANFORD UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT H.-H. NAGEL
2) * INSTITUT FUER INFORMATIK
2) * DER UNIVERSITAET HAMBURG
2) * SCHLUETERSTRASSE 70
2) * 2000 HAMBURG 13
2) * GERMANY
2) * 1976
2) *
2) * PASCAL RUNTIME SYSTEM (29-JUL-76,KISICKI)
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 30 line 1
1) (** WRTSCALAR WRTSET WRTISET WRTCSET WRTDSET **)
1) PROCEDURE wrtscalar( VAR target_file: text;
**** File 2) LIBPAS.TRY[PAS,SYS], Page 8 line 63
2) PROCEDURE wrtscalar( VAR target_file: text;
***************
**** File 1) LIBOLD.TRY[PAS,SYS], Page 30 line 16
1) IF length < i THEN write(target_file,scalar_name↑[-scalar_value]:length) lse
1) BEGIN
1) write(target_file,' ':(length-i));
1) write(target_file,scalar_name↑[-scalar_value]:i)
1) END
1) END
**** File 2) LIBPAS.TRY[PAS,SYS], Page 8 line 77
2) IF length < i THEN write(target_file,scalar_name↑[-scalar_value]:length)
2) ELSE BEGIN
2) write(target_file,' ':(length-i));
2) write(target_file,scalar_name↑[-scalar_value]:i)
2) END
2) END
***************
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,8
**** File 1) LIBOLD.TRY[PAS,SYS], Page 30 line 104
**** File 2) LIBPAS.TRY[PAS,SYS], Page 9 line 1
2) PROGRAM timing, setruntime, setelapsedtime, settime, runtime, elapsedtime,
2) timereport;
2) (*******************************************************************
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * BOARD OF TRUSTEES
2) * LELAND STANFORD JUNIOR UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * ARMANDO R. RODRIGUEZ
2) * LOTS COMPUTER FACILITY
2) * STANFORD UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * PACKAGE OF PROCEDURES TO KEEP AND REPORT RUNTIME AND ELAPSED
2) * TIME. THE TIME PERIOD THAT THEY REPORT IS THAT TRANSCURRED
2) * BETWEEN THE CALLS TO SETRUNTIME AND RUNTIME (CORR SETELAPSEDTIME
2) * AND ELAPSEDTIME) OR BETWEEN TWO CALLS TO RUNTIME (CORR ELAPSEDTIME)
2) *
2) *********************************************************************)
2) VAR
2) cputime : ARRAY[0..3] OF integer;
2) clocktime : ARRAY[0..4] OF integer;
2) ttyout: text;
2) PROCEDURE setruntime;
2) BEGIN (* SETRUNTIME *)
2) cputime[0] := clock;
2) END (* SETRUNTIME *);
2) PROCEDURE setelapsedtime;
2) BEGIN (* SETELAPSEDTIME *)
2) clocktime[0] := realtime;
2) END (* SETELAPSEDTIME *);
2) PROCEDURE settime;
2) BEGIN (* SETTIME *)
2) setruntime;
2) setelapsedtime;
2) END (* SETTIME *);
2) PROCEDURE runtime (VAR buffer: alfa);
2) (* RETURNS THE TRANSCURRED CPUTIME IN THE FORMAT 'MM:SS:MMM ' *)
2) VAR
2) temptime, j, i: integer;
2) BEGIN (* RUNTIME *)
2) temptime := clock;
2) cputime[0] := temptime - cputime[0];
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) cputime[1] := cputime[0] DIV 60000;
2) cputime[2] := (cputime[0] MOD 60000) DIV 1000;
2) cputime[3] := cputime[0] MOD 1000;
2) cputime[0] := temptime;
2) buffer := ' : . ';
2) buffer[7] := chr(cputime[3] DIV 100 + ord ('0'));
2) j := 1;
2) FOR i := 1 TO 3 DO
2) BEGIN
2) buffer[j] := chr((cputime[i] MOD 100)DIV 10 + ord('0'));
2) buffer[j + 1] := chr(cputime[i] MOD 10 + ord('0'));
2) j := j + 3 + j DIV 4;
2) END;
2) END (* RUNTIME *);
2) PROCEDURE elapsedtime (VAR buffer: alfa);
2) (* RETURNS THE ELAPSED TIME IN THE FORMAT 'HH:MM:SS.D' *)
2) VAR
2) temptime, i, j: integer;
2) BEGIN (* ELAPSEDTIME *)
2) temptime := realtime;
2) clocktime[0] := temptime - clocktime[0];
2) clocktime[1] := clocktime[0] DIV 3600000;
2) clocktime[2] := (clocktime[0] MOD 3600000) DIV 60000;
2) clocktime[3] := (clocktime[0] MOD 60000) DIV 1000;
2) clocktime[4] := (clocktime[0] MOD 1000) DIV 100
2) + (clocktime[0] MOD 100) DIV 50;
2) IF clocktime[4] = 10 THEN
2) BEGIN
2) clocktime[3] := clocktime[3] + 1;
2) clocktime[4] := 0;
2) END;
2) clocktime[0] := temptime;
2) buffer := ' : : . ';
2) j := 1;
2) FOR i := 1 TO 3 DO
2) BEGIN
2) buffer[j] := chr(clocktime[i] DIV 10 + ord('0'));
2) buffer[j + 1] := chr(clocktime[i] MOD 10 + ord('0'));
2) j := j + 3;
2) END;
2) buffer[10] := chr(clocktime[4] MOD 10 + ord('0'));
2) END (* ELAPSEDTIME *);
2) PROCEDURE timereport (VAR ttyout: text; header: alfa);
2) (* WRITES ONTO FILE TTYOUT THE CPU AND ELAPSED TIME *)
2) VAR
2) buffer1, buffer2 : alfa;
2) BEGIN (* TIMEREPORT *)
2) runtime (buffer1);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) elapsedtime (buffer2);
2) writeln(ttyout);
2) IF header <> ' ' THEN
2) write(ttyout,header,' ');
2) writeln(ttyout,'RUNTIME: ',buffer1,' ELAPSED: ',buffer2);
2) break(ttyout);
2) END (* TIMEREPORT *);
2) BEGIN
2) END.
2) PROGRAM strings, assign, length, pos, substr, concat, getchar, putchar,
2) strlt, strle, streq, strge, strgt, strne, wrtstr, wrtst1;
2) (**********************************************************************
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * BOARD OF TRUSTEES
2) * LELAND STANFORD JUNIOR UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT 1978, 1979
2) * ARMANDO R. RODRIGUEZ
2) * LOTS COMPUTER FACILITY
2) * STANFORD UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * PASCAL NON-STANDARD STRING PACKAGE (14-SEPT-78)
2) *
2) * A PACKAGE OF SUBROUTINES TO SUPPORT VARIABLE-LENGTH STRING
2) * VARIABLES IN PASCAL. THEIR CALLING DOES NOT FOLLOW THE
2) * STANDARD TYPE-CHECKING RESTRICTIONS IN PASCAL. THE COMPILER
2) * NEEDS TO KNOW ABOUT THEM AND TREAT THEIR PARAMETERS IN A
2) * SPECIAL WAY.
2) *
2) * - ASSIGN CREATE A STRING
2) *
2) * - LENGTH, POS RETURN INFORMATION ON THE STRING
2) *
2) * - SUBSTR, CONCAT,
2) * GETCHAR, PUTCHAR MOVE AROUND PARTS OF STRINGS
2) *
2) * - STRLT, STRLE, STREQ,
2) * STRGE, STRGT, STRNE COMPARE TWO STRINGS
2) *
2) * - WRTSTR, WRTST1 WRITE A STRING
2) *
2) * - READSTR READ THE REST OF THE LINE AS A STRING.
2) * IT IS WITH THE OTHER READ PROCEDURES.
2) *
2) * N. B.: SUBSTR, GETCHAR AND PUTCHAR CONTAIN CODE FOR BOUNDARY
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) * CHECKING OF THE START POSITION, WHICH WILL BE SUPERFLUOUS
2) * WHEN CHECKING FOR PARAMETER PASSING IS IMPLEMENTED.
2) *
2) *********************************************************************)
2) CONST
2) maxstrlen = 135;
2) checkstrlen = 137;
2) TYPE
2) strgrange = 1..maxstrlen;
2) strgrange0 = 0..maxstrlen;
2) string = RECORD
2) strtext: PACKED ARRAY [1..maxstrlen] OF char;
2) len: strgrange0;
2) END;
2) strgrangeneg = 0..checkstrlen;
2) error_form = (outofrange, outofstring);
2) var_form = (src_var, dest_var, final_pos);
2) pack7 = PACKED ARRAY[1..7] OF char;
2) VAR
2) error_exit: boolean;
2) errormessage: PACKED ARRAY[var_form,1..26] OF char;
2) direct_call: boolean;
2) procname: pack7;
2) INITPROCEDURE;
2) BEGIN
2) error_exit := false; direct_call := true;
2) errormessage[src_var] := 'START SOURCE POSITION ';
2) errormessage[dest_var] := 'START DESTINATION POSITION';
2) errormessage[final_pos] := 'FINAL DESTINATION POSITION';
2) END;
2) PROCEDURE stop; EXTERN;
2) PROCEDURE errinstr(errornumber: error_form; problemvar: var_form;
2) value, limit: integer);
2) BEGIN (*ERRINSTR*)
2) IF errornumber = outofrange THEN
2) write(tty,' OUT OF THE VALID RANGE 1..')
2) ELSE
2) BEGIN
2) write(tty,' GREATER THAN STRING LENGTH ');
2) IF problemvar = dest_var THEN
2) write(tty,'+ 1,');
2) END;
2) writeln(tty,limit:4,' ***',value,'***');
2) write(tty,' WHEN CALLING ',procname,' ');
2) break(tty);
2) error_exit := true;
2) END (*ERRINSTR*);
2) PROCEDURE checklength(VAR here: string; VAR length: strgrangeneg);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) VAR
2) kludge : PACKED RECORD
2) CASE boolean OF
2) true: (str: string);
2) false: (bit: PACKED ARRAY[0..35] OF 0..1);
2) END;
2) i: 0..35;
2) BEGIN (*CHECKLENGTH*)
2) IF length = checkstrlen THEN
2) BEGIN
2) kludge.str := here;
2) FOR i := 0 TO 6 DO
2) kludge.bit[i] := kludge.bit[i + 29];
2) here := kludge.str;
2) length := 1
2) END
2) ELSE
2) IF length > maxstrlen THEN
2) length := here.len;
2) END (*CHECKLENGTH*);
2) (**********************************************************************
2) *
2) * PROCEDURE ASSIGN
2) *
2) * - ASSIGNS THE STRING DEST FROM THE PACKED ARRAY OF CHAR SRC.
2) * THE COMPILER WILL ALLOW SRC TO BE OF ANY LENGTH.
2) *
2) * ASSIGN IS A PRE-DECLARED PROCEDURE
2) * AVAILABLE TO EVERY PASCAL USER.
2) *
2) *********************************************************************)
2) PROCEDURE assign(src: string; VAR dest: string; srclen: strgrange0);
2) VAR
2) i: integer;
2) BEGIN (* ASSIGN *)
2) checklength(src,srclen);
2) dest.len:=srclen;
2) FOR i:=1 TO srclen DO dest.strtext[i]:=src.strtext[i];
2) END (* ASSIGN *);
2) (**********************************************************************
2) *
2) * FUNCTION LENGTH
2) *
2) * - RETURNS THE LENGTH OF THE STRING SRC
2) *
2) * LENGTH IS A PRE-DECLARED PROCEDURE
2) * AVAILABLE TO EVERY PASCAL USER.
2) *
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) *********************************************************************)
2) FUNCTION length(src: string; srclen: strgrangeneg): strgrange0;
2) BEGIN (* LENGTH *)
2) checklength(src, srclen);
2) length:=srclen;
2) END (* LENGTH *);
2) (**********************************************************************
2) *
2) * FUNCTION POS
2) *
2) * - RETURNS THE STARTING POSITION OF THE FIRST OCCURRENCE OF THE
2) * STRING S1 IN THE STRING S2. IF THERE IS NO OCURRENCE, 0 IS
2) * RETURNED.
2) *
2) * POS IS A PRE-DECLARED FUNCTION
2) * AVAILABLE TO EVERY PASCAL USER.
2) *
2) *********************************************************************)
2) FUNCTION pos(s1, s2: string; s1len,s2len: strgrangeneg): strgrange0;
2) VAR
2) i, j, k, ind: integer;
2) matching: boolean;
2) BEGIN (* POS *)
2) ind:=0;
2) i := 1;
2) checklength(s1,s1len);
2) checklength(s2,s2len);
2) WHILE (i <= s2len - s1len + 1) AND (ind = 0) DO
2) BEGIN
2) k := i;
2) j := 1;
2) matching := true;
2) WHILE (j <= s1len) AND matching DO
2) IF s2.strtext[k] = s1.strtext[j] THEN
2) BEGIN
2) j := j + 1;
2) k := k + 1;
2) END
2) ELSE
2) matching := false;
2) IF matching THEN
2) ind := i
2) ELSE
2) i := i + 1;
2) END;
2) pos := ind;
2) END (* POS *);
2) (**********************************************************************
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) *
2) * PROCEDURE SUBSTR
2) *
2) * - COPIES AT MOST LENG CHARACTERS FROM STRING SRC TO STRING DEST,
2) * STARTING AT POSITION SRCPOS IN SRC, DESTPOS IN DEST. DEST.LEN
2) * WILL BE CHANGED IF NEEDED. IF SRCPOS + LENG IS TOO LONG,
2) * ONLY (SRC.LEN - SRCPOS + 1) CHARACTERS WILL BE COPIED.
2) * IF DESTPOS + LENG - 1 > MAXSTRLEN, ERROR.
2) * IF SRCPOS OR DESTPOS IS OUTSIDE THE STRING, ERROR.
2) *
2) * SUBSTR IS A PRE-DECLARED PROCEDURE
2) * AVAILABLE TO EVERY PASCAL USER.
2) *
2) *********************************************************************)
2) PROCEDURE substr(src: string; VAR dest: string;
2) srcpos, destpos, leng: strgrange; srclen: strgrangeneg);
2) VAR
2) idest, isrc, netsrcleng, destlast, lastlast: integer;
2) BEGIN (*SUBSTR*)
2) IF leng > 0 THEN
2) BEGIN
2) IF direct_call THEN
2) procname := 'SUBSTR ';
2) checklength(src,srclen);
2) IF (srcpos < 1) OR (srcpos > maxstrlen) THEN
2) errinstr(outofrange,src_var,srcpos,maxstrlen)
2) ELSE
2) IF (destpos < 1) OR (destpos > maxstrlen) THEN
2) errinstr(outofrange,dest_var,destpos,maxstrlen)
2) ELSE
2) IF srcpos > srclen THEN
2) errinstr(outofstring,src_var,srcpos,srclen)
2) ELSE
2) IF destpos > dest.len + 1 THEN
2) errinstr(outofstring,dest_var,destpos,dest.len + 1)
2) ELSE
2) IF (destpos + leng - 1) > maxstrlen THEN
2) errinstr(outofstring,final_pos,destpos+srclen-1,maxstrlen);
2) IF error_exit THEN
2) IF direct_call THEN
2) BEGIN
2) error_exit := false;
2) stop
2) END
2) ELSE
2) ELSE (* NO BOUNDS ERRORS *)
2) BEGIN
2) netsrcleng := min (leng, srclen + 1 - srcpos);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) destlast := destpos + netsrcleng - 1;
2) isrc := srcpos;
2) FOR idest := destpos TO destlast DO
2) BEGIN
2) dest.strtext[idest] := src.strtext[isrc];
2) isrc := isrc + 1;
2) END;
2) IF destlast > dest.len THEN
2) dest.len := destlast;
2) END
2) END
2) END (* SUBSTR*);
2) (**********************************************************************
2) *
2) * PROCEDURE CONCAT
2) *
2) * - COPIES STRING S1 TO THE END OF STRING S2
2) * S1 IS NOT AFFECTED
2) *
2) * CONCAT IS A PREDEFINED PROCEDURE
2) * AVAILABLE TO EVERY PASCAL USER.
2) *********************************************************************)
2) PROCEDURE concat (src: string; VAR dest: string; srclen: strgrangeneg);
2) BEGIN (*CONCAT*)
2) direct_call := false;
2) procname := 'CONCAT ';
2) checklength(src,srclen);
2) substr(src,dest,1,dest.len+1,srclen,srclen);
2) IF error_exit THEN
2) BEGIN
2) direct_call := true;
2) error_exit := false;
2) stop
2) END;
2) END (*CONCAT*);
2) (**********************************************************************
2) *
2) * FUNCTION GETCHAR
2) *
2) * - RETURN THE CHARACTER CONTAINED IN POSITION SRCPOS OF STRING SRC.
2) * IF SRCPOS FALLS OUT OF THE VALID STRING, ERRINSTR.
2) *
2) * GETCHAR IS A PRE-DECLARED FUNCTION
2) * AVAILABLE TO EVERY PASCAL USER.
2) *
2) *********************************************************************)
2) FUNCTION getchar (src: string; srcpos: strgrange; srclen: strgrangeneg): char;
2) VAR
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) ch: char;
2) BEGIN (* GETCHAR *)
2) procname := 'GETCHAR';
2) checklength(src,srclen);
2) IF (srcpos < 1) OR (srcpos > maxstrlen) THEN
2) errinstr(outofrange,src_var,srcpos,maxstrlen)
2) ELSE
2) IF srcpos > srclen THEN
2) errinstr(outofstring,src_var,srcpos,srclen);
2) IF error_exit THEN
2) BEGIN
2) error_exit := false;
2) stop
2) END
2) ELSE
2) getchar := src.strtext[srcpos];
2) END (* GETCHAR *);
2) (**********************************************************************
2) *
2) * PROCEDURE PUTCHAR
2) *
2) * - PUTS THE CHARACTER SRC AT POSITION DESTPOS IN STRING DEST.
2) * IF DESTPOS > DEST.LEN, ERROR
2) *
2) * PUTCHAR IS A PRE-DECLARED PROCEDURE
2) * AVAILABLE TO EVERY PASCAL USER.
2) *
2) *********************************************************************)
2) PROCEDURE putchar (src: char; VAR dest: string; destpos: strgrange);
2) BEGIN (* PUTCHAR *)
2) procname := 'PUTCHAR';
2) IF (destpos < 1) OR (destpos > maxstrlen) THEN
2) errinstr(outofrange,dest_var,destpos,maxstrlen)
2) ELSE
2) IF destpos > dest.len + 1 THEN
2) errinstr(outofstring,dest_var,destpos,dest.len + 1);
2) IF error_exit THEN
2) BEGIN
2) error_exit := false;
2) stop;
2) END
2) ELSE
2) BEGIN
2) dest.strtext[destpos] := src;
2) IF destpos > dest.len THEN
2) dest.len := destpos;
2) END
2) END (* PUTCHAR *);
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) (**********************************************************************
2) *
2) * FUNCTIONS TO COMPARE STRINGS: STRLT, STRLE, STREQ,
2) * STRGE, STRGT, STRNE
2) *
2) * - EACH ONE RETURNS THE RESULT OF THE COMPARISON OF STRINGS
2) * S1 AND S2, ACCORDING TO THE LAST TWO LETTERS OF ITS NAME.
2) *
2) * A STRING S1 IS EQUAL TO S2 IF
2) * 1. THEY ARE OF THE SAME LENGTH, AND
2) * 2. THEIR CHARACTERS ARE EQUAL IN EVERY POSITION.
2) *
2) * A STRING S1 IS GREATER THAN S2 IF
2) * 1. THEIR CHARACTERS ARE EQUAL IN POSITIONS 1, ..., X-1
2) * AND S1 HAS A CHARACTER GREATER IN THE COLLATING
2) * SEQUENCE IN POSITION X, OR
2) * 2. THEIR CHARACTERS ARE EQUAL IN POSITIONS 1, ...,
2) * S2.LEN, AND S1.LEN > S2.LEN.
2) *
2) * THEY ARE ALL PRE-DECLARED FUNCTIONS
2) * AVAILABLE TO EVERY PASCAL USER.
2) *
2) *********************************************************************)
2) FUNCTION strgt(s1, s2: string; s1len,s2len: strgrangeneg): boolean;
2) VAR
2) i, tmin: integer;
2) answer: boolean;
2) BEGIN (* STRGT *)
2) checklength(s1,s1len);
2) checklength(s2,s2len);
2) tmin:= min(s1len, s2len);
2) answer := false;
2) i := 1;
2) WHILE (i <= tmin) AND (s1.strtext[i] = s2.strtext[i]) DO
2) i := i + 1;
2) IF i <= s1len THEN
2) IF i <= s2len THEN
2) answer := s1.strtext[i] > s2.strtext[i]
2) ELSE
2) answer := true;
2) strgt := answer;
2) END (* STRGT *);
2) FUNCTION strge(s1, s2: string; s1len,s2len: strgrangeneg): boolean;
2) BEGIN (*STRGE*)
2) strge := NOT strgt(s2, s1, s2len, s1len);
2) END (*STRGE*);
2) FUNCTION streq(s1, s2: string; s1len,s2len: strgrangeneg): boolean;
2) VAR
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) i, tmin: integer;
2) answer: boolean;
2) BEGIN (* STREQ *)
2) checklength(s1,s1len);
2) checklength(s2,s2len);
2) IF s1len <> s2len THEN
2) answer := false
2) ELSE
2) BEGIN
2) answer := true;
2) i := 1;
2) WHILE (i <= s1len) AND answer DO
2) BEGIN
2) IF s1.strtext[i] <> s2.strtext[i] THEN
2) answer := false;
2) i := i + 1;
2) END;
2) END;
2) streq := answer;
2) END (* STREQ *);
2) FUNCTION strle(s1, s2: string; s1len,s2len: strgrangeneg): boolean;
2) BEGIN (*STRLE*)
2) strle := NOT strgt(s1, s2, s1len, s2len);
2) END (*STRLE*);
2) FUNCTION strlt(s1, s2: string; s1len,s2len: strgrangeneg): boolean;
2) BEGIN (*STRLT*)
2) strlt := strgt(s2, s1, s2len, s1len);
2) END (*STRLT*);
2) FUNCTION strne(s1, s2: string; s1len,s2len: strgrangeneg): boolean;
2) BEGIN (*STRNE*)
2) strne := NOT streq(s1, s2, s1len, s2len);
2) END (*STRNE*);
2) PROCEDURE wrtstr(VAR dest_file:text; src: string; totallength: integer);
2) BEGIN (*WRTSTR*)
2) write(dest_file,src.strtext:totallength);
2) END (*WRTSTR*);
2) PROCEDURE wrtst1(VAR dest_file:text; src: string; totallength: integer);
2) BEGIN (*WRTST1*)
2) write(dest_file,src.strtext:src.len);
2) END (*WRTST1*);
2) BEGIN
2) END.
2) PROGRAM dumper, dpcnts;
2) (**********************************************************************
2) *
2) * (C) COPYRIGHT 1979
2) * BOARD OF TRUSTEES
2) * LELAND STANFORD JUNIOR UNIVERSITY
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT 1979,
2) * ARMANDO R. RODRIGUEZ
2) * LOTS COMPUTER FACILITY
2) * STANFORD UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * AUXILIARY ROUTINES FOR STATEMENT COUNTS (PROFILE)
2) * AS IMPLEMENTED BY PHILIP WISOFF, FEB-79
2) *
2) * DPCNTS:
2) * DUMPS TO A FILE OF INTEGER THE LINE/PAGE MARKERS AND
2) * THE COUNTS FOR EACH BASIC BLOCK.
2) *
2) *********************************************************************)
2) TYPE
2) dfiletype = FILE OF integer;
2) packed9 = PACKED ARRAY [1..9] OF char;
2) VAR
2) dumpfile : dfiletype;
2) PROCEDURE dpcnts (filename : packed9;startofcounts,endofcounts : integer);
2) TYPE
2) linerange = 1..777777B;
2) pointer = RECORD
2) CASE boolean OF
2) true : (location : ↑data);
2) false : (incloc : linerange);
2) END;
2) data = PACKED RECORD
2) page,line : linerange;
2) count : integer;
2) END;
2) VAR
2) dataptr : pointer;
2) countdata : data;
2) BEGIN (*DPCNTS*)
2) rewrite(dumpfile,filename); (*OPEN THE FILE*)
2) WITH dataptr DO BEGIN
2) dataptr.incloc := startofcounts;
2) WHILE dataptr.incloc <= endofcounts DO (*FOR EACH COUNT MARKER*)
2) BEGIN
2) WITH dataptr DO BEGIN (*DUMP LINE, PAGE AND COUNT*)
2) dumpfile↑ := location↑.page;
2) put(dumpfile);
2) dumpfile↑ := location↑.line;
2) put(dumpfile);
2) dumpfile↑ := location↑.count;
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
2) put(dumpfile);
2) END;
2) dataptr.incloc := dataptr.incloc + 2; (*AND GO TO THE NEXT*)
2) END;
2) END;
2) reset(dumpfile,filename); (*CLOSE THE FILE*)
2) END;
2) BEGIN
2) END.
2) PROGRAM mathruns, psqrt;
2) (**********************************************************************
2) *
2) * (C) COPYRIGHT 1979
2) * BOARD OF TRUSTEES
2) * LELAND STANFORD JUNIOR UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * (C) COPYRIGHT 1979,
2) * ARMANDO R. RODRIGUEZ
2) * LOTS COMPUTER FACILITY
2) * STANFORD UNIVERSITY
2) * STANFORD, CA. 94305, U. S. A.
2) *
2) * MATHEMATICALLY-ORIENTED RUNTIMES FOR THE PASCAL COMPILER.
2) *
2) * PSQRT:
2) * CHECKS FOR THE PARAMETER TO THE FORTRAN ROUTINE FOR
2) * SQRT TO BE A POSITIVE REAL NUMBER.
2) *
2) *********************************************************************)
2) PROCEDURE stop; EXTERN;
2) FUNCTION sqrt(fvalue:real): real; FORTRAN;
2) FUNCTION psqrt(fvalue: real): real;
2) BEGIN (*PSQRT*)
2) IF fvalue < 0 THEN
2) BEGIN
2) writeln(tty);
2) writeln(tty,'%? VALUE ERROR: ATTEMPT TO OBTAIN THE SQUARE ROOT OF A NEGATIVE NUMBER');
2) writeln(tty,'%? VALUE PASED: ',fvalue);
2) write(tty,'%? ');
2) break(tty);
2) stop;
2) END
2) ELSE
2) psqrt := sqrt(fvalue);
2) END (*PSQRT*);
2) BEGIN
2) END.
1) LIBOLD.TRY[PAS,SYS] and 2) LIBPAS.TRY[PAS,SYS] 7-05-79 11:12 pages 30,9
***************